home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / MSDOS / (m)aak / DRAW!.BAS < prev    next >
BASIC Source File  |  1987-06-13  |  19KB  |  400 lines
  1. 100 REM  DRAW!  version 1.75  Release 2       BASLINK it first
  2. 110 PRINT"Setting up..."
  3. 120 KEY OFF
  4. 130 DEF SEG= &HB800
  5. 140 L=1:C=1:PNX=315:PNY=95
  6. 150 RANDOMIZE VAL(RIGHT$(TIME$,2))
  7. 160 DIM BOX(1172), FSCRN(8008), MVER(1500), PNTR(6)
  8. 170 LOCATE ,,,6,8
  9. 180 CEDG$="degrees":PI=3.141592654#:X=320:Y=100:R=100:F=0:T=360:A=5/12:IC=0:CCOL=1
  10. 190 NUMST=75:YLIM=199:XLIM=639
  11. 200 BULX=0:BULY=0:BLRX=639:BLRY=199
  12. 210 MOVACT$="move"
  13. 220 FOR K=1 TO 10:KEY K,"":NEXT K
  14. 230 '--------------------------------------------------------------------------
  15. 240 REM short cut labels
  16. 250 '--------------------------------------------------------------------------
  17. 260 REM event trapping
  18. 270 KEY 15,CHR$(&H4)+CHR$(72):ON KEY (15) GOSUB 940 'ctrl-up
  19. 280 KEY 16,CHR$(&H4)+CHR$(80):ON KEY (16) GOSUB 980 'ctrl-down
  20. 290 KEY 17,CHR$(&H4)+CHR$(76):ON KEY (17) GOSUB 1020 'ctrl-5 (keypad)
  21. 300 KEY 18,CHR$(&H8)+CHR$(35):ON KEY (18) GOSUB 3480 'alt-h (help)
  22. 310 KEY 19,CHR$(&H4)+CHR$(70):ON KEY (19) GOSUB 1060 'ctrl-break
  23. 320 KEY (18) ON:KEY (19) ON 'alt-h & ctrl-break on
  24. 330 ON ERROR GOTO 3560
  25. 340 '--------------------------------------------------------------------------
  26. 350 REM get filename
  27. 360 SCREEN 0,0,0:WIDTH 80:COLOR 7,1,1:CLS
  28. 370 LOCATE 5,1:FILES "*.pic"
  29. 380 LOCATE 12,1:FILES "*.bak"
  30. 390 LOCATE 23,1:PRINT"Make sure CapsLock and NumLock are off before using this program!!!"
  31. 400 BEEP:LOCATE 1,1:INPUT "Filename (no extension)";INSPEC$
  32. 410 IF INSPEC$="" THEN 400
  33. 420 IF INSTR(INSPEC$,".")<>0 THEN LOCATE 25,30:PRINT"I SAID NO EXTENSION!":GOTO 400
  34. 430 SPEC$=LEFT$(INSPEC$,8)+".pic"
  35. 440 BACK$=LEFT$(INSPEC$,8)+".bak"
  36. 450 SCREEN 2:OUT &H3D9,7:BLOAD SPEC$:PRESET (0,0):CH=0
  37. 460 '--------------------------------------------------------------------------
  38. 470 REM main input area
  39. 480 FOR KO=15 TO 17:KEY (KO) ON:NEXT KO
  40. 490 A$=INKEY$:IF A$="" THEN 480
  41. 500 REM text input
  42. 510 IF A$=CHR$(13) THEN L=L+1:C=1:LOCATE L,C:SOUND 2000,.5:GOTO 480
  43. 520 IF A$=CHR$(8) THEN LOCATE L,C-1:PRINT CHR$(32):C=C-1:SOUND 1000,.2:GOTO 480:
  44. 530 IF ASC(A$)>0 AND ASC(A$)<>12 THEN LOCATE L,C:PRINT A$:SOUND 2000,.2:C=C+1:CH=1:GOTO 480:
  45. 540 REM other keys
  46. 550 IF A$=CHR$(0)+CHR$(16) THEN 1300 '[alt][q] quit
  47. 560 IF A$=CHR$(0)+CHR$(19) THEN 1370 '[alt][r] shell
  48. 570 IF A$=CHR$(0)+CHR$(20) THEN 1460 '[alt][t] stars
  49. 580 IF A$=CHR$(0)+CHR$(31) THEN 1640 '[alt][s] status
  50. 590 IF A$=CHR$(0)+CHR$(34) THEN 1730 '[alt][g] grid
  51. 600 IF A$=CHR$(0)+CHR$(35) THEN 3480 '[alt][h] help
  52. 610 IF A$=CHR$(0)+CHR$(38) THEN 1870 '[alt][l] lines
  53. 620 IF A$=CHR$(0)+CHR$(46) THEN 2100 '[alt][c] circles
  54. 630 IF A$=CHR$(0)+CHR$(48) THEN 2450 '[alt][b] boxes
  55. 640 IF A$=CHR$(0)+CHR$(25) THEN 2810 '[alt][p] paint
  56. 650 IF A$=CHR$(0)+CHR$(50) THEN 2930 '[alt][m] merge
  57. 660 IF A$=CHR$(0)+CHR$(59) THEN DRAW "c0":SOUND 40,1:GOTO 480 '[f1]
  58. 670 IF A$=CHR$(0)+CHR$(60) THEN DRAW "c1":SOUND 4000,1:GOTO 480 '[f2]
  59. 680 IF A$=CHR$(0)+CHR$(61) THEN BLOAD SPEC$:CH=0:GOTO 480'[f3] load
  60. 690 IF A$=CHR$(0)+CHR$(62) THEN 860 '[f4] save
  61. 700 IF A$=CHR$(0)+CHR$(63) THEN 3020 '[f5] text pos
  62. 710 IF A$=CHR$(0)+CHR$(64) THEN 3120 '[f6] pixel pos
  63. 720 IF A$=CHR$(0)+CHR$(65) THEN 3180 '[F7] move/copy
  64. 730 IF A$=CHR$(0)+CHR$(71) THEN DRAW "h1":SOUND 500,.05:CH=1:GOTO 480 'home
  65. 740 IF A$=CHR$(0)+CHR$(72) THEN DRAW "u1":SOUND 500,.05:CH=1:GOTO 480 'up
  66. 750 IF A$=CHR$(0)+CHR$(73) THEN DRAW "e1":SOUND 500,.05:CH=1:GOTO 480 'pgup
  67. 760 IF A$=CHR$(0)+CHR$(77) THEN DRAW "r1":SOUND 500,.05:CH=1:GOTO 480 'rght
  68. 770 IF A$=CHR$(0)+CHR$(81) THEN DRAW "f1":SOUND 500,.05:CH=1:GOTO 480 'pgdn
  69. 780 IF A$=CHR$(0)+CHR$(80) THEN DRAW "d1":SOUND 500,.05:CH=1:GOTO 480 'dn
  70. 790 IF A$=CHR$(0)+CHR$(79) THEN DRAW "g1":SOUND 500,.05:CH=1:GOTO 480 'end
  71. 800 IF A$=CHR$(0)+CHR$(75) THEN DRAW "l1":SOUND 500,.05:CH=1:GOTO 480 'left
  72. 810 IF A$=CHR$(0)+CHR$(83) THEN 3380 '[del] new file
  73. 820 IF A$=CHR$(0)+CHR$(115) THEN DRAW "l50":SOUND 500,2.5:CH=1:GOTO 480
  74. 830 IF A$=CHR$(0)+CHR$(116) THEN DRAW "r50":SOUND 500,2.5:CH=1:GOTO 480
  75. 840 SOUND 3000,.3:GOTO 480 'anything else?
  76. 850 '--------------------------------------------------------------------------
  77. 860 KILL BACK$
  78. 870 NAME SPEC$ AS BACK$
  79. 880 BSAVE SPEC$,0,&H4000:CH=0
  80. 890 GOTO 480
  81. 900 '**************************************************************************
  82. 910 '                          TRAPPED ROUTINES
  83. 920 '**************************************************************************
  84. 930 REM up 50
  85. 940 DRAW "u50"
  86. 950 SOUND 500,2.5
  87. 960 RETURN
  88. 970 REM down 50
  89. 980 DRAW "d50"
  90. 990 SOUND 500,2.5
  91. 1000 RETURN
  92. 1010 REM centre of screen
  93. 1020 SOUND 1000,.1
  94. 1030 PRESET (320,100)
  95. 1040 RETURN
  96. 1050 REM break trap
  97. 1060 IF CH=0 THEN 1100 ELSE GOSUB 3970:LOCATE 11,20:PRINT"Are you sure? (Y or N)":BEEP
  98. 1070 A$=INKEY$:IF A$="" THEN 1070
  99. 1080 IF A$="Y" OR A$="y" THEN 1100
  100. 1090 IF A$="N" OR A$="n" THEN GOSUB 4030:GOTO 480 ELSE SOUND 3000,.3:GOTO 1070
  101. 1100 KEY 1,"cls:list"+CHR$(13)
  102. 1110 KEY 2,"run"+CHR$(13)
  103. 1120 KEY 3,"load "+CHR$(34)
  104. 1130 KEY 4,"save "+CHR$(34)
  105. 1140 KEY 5,"list "
  106. 1150 KEY 6,"edit "
  107. 1160 KEY 7,"files"+CHR$(13)
  108. 1170 KEY 8,"width 80"+CHR$(13)
  109. 1180 KEY 9,"color ,1,1:cls"+CHR$(13)
  110. 1190 KEY 10,"screen 0,0,0"+CHR$(13)
  111. 1200 SCREEN 0
  112. 1210 COLOR 7,1,1
  113. 1220 CLS
  114. 1230 SOUND 1000,5
  115. 1240 ON ERROR GOTO 0
  116. 1250 STOP
  117. 1260 '**************************************************************************
  118. 1270 '                          MAIN ROUTINES
  119. 1280 '**************************************************************************
  120. 1290 REM quit to DOS
  121. 1300 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO:MODE=4:GOSUB 3970
  122. 1310 IF CH=1 THEN LOCATE 13,20:PRINT"work has not been saved!!!!"
  123. 1320 LOCATE 11,20:BEEP:PRINT"are you sure? (y or n)":BEEP
  124. 1330 A$=INKEY$:IF A$="" THEN 1330
  125. 1340 IF A$="Y" OR A$="y" THEN SCREEN 0,0,0:COLOR 7,1,1:CLS:SYSTEM
  126. 1350 IF A$="N" OR A$="n" THEN GOSUB 4030:GOTO 480 ELSE SOUND 3000,.3:GOTO 1330
  127. 1360 REM dos shell
  128. 1370 GET (0,0)-(639,199),FSCRN
  129. 1380 GOSUB 3980
  130. 1390 LOCATE 13,20:INPUT "DOS command";DCOM$
  131. 1400 SCREEN 0,0,0:SHELL DCOM$
  132. 1410 LOCATE 25,29:COLOR 23:PRINT"press any key to return"
  133. 1420 A$=INKEY$:IF A$="" THEN 1420
  134. 1430 SCREEN 2:OUT &H3D9,7:PUT (0,0),FSCRN,PSET
  135. 1440 GOTO 480
  136. 1450 REM starfield
  137. 1460 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO
  138. 1470 NUMST$=RIGHT$(STR$(NUMST),LEN(STR$(NUMST))-1)
  139. 1480 GOSUB 3970 '39
  140. 1490 LOCATE 11,20:PRINT "X-coordinate limit [";STR$(XLIM);"]"
  141. 1500 LOCATE 12,20:PRINT "Y-coordinate limit [";STR$(YLIM);"]"
  142. 1510 LOCATE 13,20:PRINT "   Number of stars [";NUMST$;"]"
  143. 1520 LOCATE 11,41+LEN(STR$(XLIM)):INPUT XLIM1:IF XLIM1<>0 THEN XLIM=XLIM1
  144. 1530 LOCATE 12,41+LEN(STR$(YLIM)):INPUT YLIM1:IF YLIM1<>0 THEN YLIM=YLIM1
  145. 1540 LOCATE 13,41+LEN(NUMST$):INPUT NUMST1:IF NUMST1<>0 THEN NUMST=NUMST1
  146. 1550 GOSUB 4030
  147. 1560 REM plot stars
  148. 1570 FOR S=1 TO NUMST
  149. 1580 IF XLIM>0 THEN STX=CINT(RND*XLIM) ELSE XLIM2=ABS(XLIM):STX=CINT(RND*(639-XLIM2))+XLIM2
  150. 1590 IF YLIM>0 THEN STY=CINT(RND*YLIM) ELSE YLIM2=ABS(YLIM):STY=CINT(RND*(199-YLIM2))+YLIM2
  151. 1600 PSET (STX,STY)
  152. 1610 NEXT S
  153. 1620 PRESET (0,0):CH=1:GOTO 480
  154. 1630 REM status
  155. 1640 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO:MODE=6:GOSUB 3970
  156. 1650 LOCATE 11,20:PRINT"printing on line";L;"and column";C
  157. 1660 LOCATE 12,20:PRINT"filespec for this drawing is ";SPEC$
  158. 1670 LOCATE 13,20:PRINT"the time is ";TIME$
  159. 1680 LOCATE 15,20:PRINT"press any key to return.":BEEP
  160. 1690 A$=INKEY$:IF A$="" THEN 1690
  161. 1700 GOSUB 4030
  162. 1710 GOTO 480
  163. 1720 REM grid
  164. 1730 GET (0,0)-(639,199),FSCRN
  165. 1740 FOR GV=40 TO 600 STEP 40
  166. 1750 LINE (GV,0)-(GV,199)
  167. 1760 LOCATE 1,GV/8:PRINT GV
  168. 1770 NEXT GV
  169. 1780 FOR GH=16 TO 176 STEP 16
  170. 1790 LINE (0,GH)-(639,GH)
  171. 1800 LOCATE GH/8,2:PRINT GH
  172. 1810 NEXT GH
  173. 1820 LOCATE 4,28:PRINT "Press any key to return."
  174. 1830 A$=INKEY$:IF A$="" THEN 1830
  175. 1840 PUT (0,0),FSCRN,PSET
  176. 1850 GOTO 480
  177. 1860 REM lines
  178. 1870 GET (0,0)-(639,199),FSCRN:GOSUB 3700
  179. 1880 LXS=PNX+5:LYS=PNY+5
  180. 1890 LXE=LXS:LYE=LYS
  181. 1900 LXE2=LXS:LYE2=LYS
  182. 1910 COL=1
  183. 1920 A$=INKEY$:IF A$="" THEN GOTO 1920
  184. 1930 IF A$=CHR$(27) THEN PUT (0,0),FSCRN,PSET:GOTO 480
  185. 1940 IF A$=CHR$(0)+CHR$(59) THEN SOUND 40,1:COL=0:GOTO 1920
  186. 1950 IF A$=CHR$(0)+CHR$(60) THEN SOUND 4000,1:COL=1:GOTO 1920
  187. 1960 IF A$=CHR$(13) THEN PUT (0,0),FSCRN,PSET:LINE (LXS,LYS)-(LXE,LYE),COL:CH=1:GOTO 480
  188. 1970 IF A$=CHR$(0)+CHR$(72) THEN LYE2=LYE2-1:GOTO 2050 'up
  189. 1980 IF A$=CHR$(0)+CHR$(75) THEN LXE2=LXE2-1:GOTO 2050 'left
  190. 1990 IF A$=CHR$(0)+CHR$(77) THEN LXE2=LXE2+1:GOTO 2050 'right
  191. 2000 IF A$=CHR$(0)+CHR$(80) THEN LYE2=LYE2+1:GOTO 2050 'down
  192. 2010 IF A$=CHR$(56) THEN LYE2=LYE2-10:GOTO 2050 'up 10
  193. 2020 IF A$=CHR$(52) THEN LXE2=LXE2-20:GOTO 2050 'left 20
  194. 2030 IF A$=CHR$(54) THEN LXE2=LXE2+20:GOTO 2050 'right 20
  195. 2040 IF A$=CHR$(50) THEN LYE2=LYE2+10 ELSE SOUND 3000,.3:GOTO 1920 'down 10
  196. 2050 LINE (LXS,LYS)-(LXE,LYE),0
  197. 2060 LXE=LXE2:LYE=LYE2
  198. 2070 LINE (LXS,LYS)-(LXE,LYE),1
  199. 2080 GOTO 1920
  200. 2090 REM circles
  201. 2100 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO
  202. 2110 MODE=7:GET (0,0)-(639,199),FSCRN:GOSUB 3970
  203. 2120 LOCATE 11,20:PRINT" S - Set up parameters"
  204. 2130 LOCATE 12,20:PRINT" P - Use Pointer for centre; goto `s' opt"
  205. 2140 LOCATE 13,20:PRINT" D - Draw according to current parameters"
  206. 2150 LOCATE 14,20:PRINT" E - Erase current circle"
  207. 2160 'locate 15,20:print" C - Change circle units; currently ";cedg$
  208. 2170 A$=INKEY$:IF A$="" THEN 2170
  209. 2180 IF A$="S" OR A$="s" THEN 2240
  210. 2190 IF A$="P" OR A$="p" THEN GOSUB 4030:GOSUB 3700:X=PNX+5:Y=PNY+5:GOTO 2240
  211. 2200 IF A$="D" OR A$="d" THEN CCOL=1:GOTO 2400
  212. 2210 IF A$="E" OR A$="e" THEN CCOL=0:GOTO 2400
  213. 2220 'if a$="C" or a$="c" then if cedg$="radians" then cedg$="degrees":locate 15,56:?cedg$ else cedg$="radians":locate 15,56:?cedg$:sound 3000,.3:goto 2170
  214. 2230 IF A$=CHR$(27) THEN GOSUB 4030:GOTO 480 ELSE SOUND 3000,.3:GOTO 2170
  215. 2240 GOSUB 3980
  216. 2250 MODE=8
  217. 2260 LOCATE 11,20:PRINT "X coordinate [";RIGHT$(STR$(X),LEN(STR$(X))-1);"]"
  218. 2270 LOCATE 12,20:PRINT "Y coordinate [";RIGHT$(STR$(Y),LEN(STR$(Y))-1);"]"
  219. 2280 LOCATE 13,20:PRINT "      Radius [";RIGHT$(STR$(R),LEN(STR$(R))-1);"]"
  220. 2290 LOCATE 11,35+LEN(STR$(X)):INPUT X1:IF X1<>0 THEN X=X1
  221. 2300 LOCATE 12,35+LEN(STR$(Y)):INPUT Y1:IF Y1<>0 THEN Y=Y1
  222. 2310 LOCATE 13,35+LEN(STR$(R)):INPUT R1:IF R1<>0 THEN R=R1
  223. 2320 GOSUB 3980
  224. 2330 LOCATE 11,20:PRINT "    Arc from [";STR$(F);"]"
  225. 2340 LOCATE 12,20:PRINT "      Arc to [";STR$(T);"]"
  226. 2350 LOCATE 13,20:PRINT "Aspect ratio [";STR$(A);"]"
  227. 2360 LOCATE 11,36+LEN(STR$(F)):INPUT F1$:IF F1$<>"" THEN F=VAL(F1$)
  228. 2370 LOCATE 12,36+LEN(STR$(T)):INPUT T1$:IF T1$<>"" THEN T=VAL(T1$)
  229. 2380 LOCATE 13,36+LEN(STR$(A)):INPUT A1:IF A1<>0 THEN A=A1
  230. 2390 GOSUB 3980:GOTO 2120
  231. 2400 GOSUB 4030
  232. 2410 CIRCLE (X,Y),R,CCOL,F*(PI/180),T*(PI/180),A
  233. 2420 CH=1:GOTO 480
  234. 2430 '--------------------------------------------------------------------------
  235. 2440 REM boxes
  236. 2450 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO:MODE=9
  237. 2460 GOSUB 3970
  238. 2470 LOCATE 11,20:PRINT"P - Use Pointer for box"
  239. 2480 LOCATE 12,20:PRINT"C - Specify coordinates of box"
  240. 2490 LOCATE 13,20:PRINT"D - Draw defined box"
  241. 2500 LOCATE 14,20:PRINT"E - Erase defined box"
  242. 2510 LOCATE 15,20:PRINT"B - Draw screen border"
  243. 2520 A$=INKEY$:IF A$="" THEN GOTO 2520
  244. 2530 IF A$="P" OR A$="p" THEN 2620
  245. 2540 IF A$="C" OR A$="c" THEN 2690
  246. 2550 IF A$="D" OR A$="d" THEN BCOL=1:GOSUB 2590
  247. 2560 IF A$="E" OR A$="e" THEN BCOL=0:GOSUB 2590
  248. 2570 IF A$="B" OR A$="b" THEN 2660
  249. 2580 IF A$=CHR$(27) THEN GOSUB 4030:GOTO 480 ELSE SOUND 3000,.3:GOTO 2520
  250. 2590 GOSUB 4030
  251. 2600 LINE (BULX,BULY)-(BLRX,BLRY),BCOL,B
  252. 2610 GOTO 480
  253. 2620 GOSUB 4030:GET (0,0)-(639,199),FSCRN
  254. 2630 GOSUB 3700:BULX=PNX+5:BULY=PNY+5:PSET (BULX,BULY)
  255. 2640 GOSUB 3700:BLRX=PNX+5:BLRY=PNY+5
  256. 2650 GOTO 2450
  257. 2660 GOSUB 4030
  258. 2670 LINE (0,0)-(639,199),,B
  259. 2680 CH=1:GOTO 480
  260. 2690 GOSUB 3980
  261. 2700 LOCATE 11,20:PRINT "Upper-left X [";RIGHT$(STR$(BULX),LEN(STR$(BULX))-1);"]"
  262. 2710 LOCATE 12,20:PRINT "Upper-left Y [";RIGHT$(STR$(BULY),LEN(STR$(BULY))-1);"]"
  263. 2720 LOCATE 14,20:PRINT "Lower-right X [";RIGHT$(STR$(BLRX),LEN(STR$(BLRX))-1);"]"
  264. 2730 LOCATE 15,20:PRINT "Lower-right Y [";RIGHT$(STR$(BLRY),LEN(STR$(BLRY))-1);"]"
  265. 2740 LOCATE 11,35+LEN(STR$(BULX))-1:INPUT BULX1:IF BULX1<>0 THEN BULX=BULX1
  266. 2750 LOCATE 12,35+LEN(STR$(BULY))-1:INPUT BULY1:IF BULY1<>0 THEN BULY=BULY1
  267. 2760 LOCATE 14,35+LEN(STR$(BLRX))-1:INPUT BLRX1:IF BLRX1<>0 THEN BLRX=BLRX1
  268. 2770 LOCATE 15,35+LEN(STR$(BLRY))-1:INPUT BRLY1:IF BLRY1<>0 THEN BLRY=BLRY1
  269. 2780 GOSUB 4030:GOTO 2450
  270. 2790 '--------------------------------------------------------------------------
  271. 2800 REM painter
  272. 2810 GOSUB 3970
  273. 2820 LOCATE 11,20:PRINT"P - Point to area to be painted"
  274. 2830 LOCATE 13,20:PRINT"2 - Paint, with colour 2 (gray)"
  275. 2840 LOCATE 15,20:PRINT"3 - Paint, with colour 3 (white)"
  276. 2850 A$=INKEY$:IF A$="" THEN GOTO 2850
  277. 2860 IF A$="P" OR A$="p" THEN 2900
  278. 2870 IF A$="2" THEN GOSUB 4030:PAINT (PX,PY),CHR$(85)+CHR$(170):CH=1:GOTO 480
  279. 2880 IF A$="3" THEN GOSUB 4030:PAINT (PX,PY),CHR$(255):CH=1:GOTO 480
  280. 2890 IF A$=CHR$(27) THEN GOSUB 4030:GOTO 480 ELSE SOUND 3000,.3:GOTO 2850
  281. 2900 GOSUB 4030:GET (0,0)-(639,199),FSCRN:GOSUB 3700:PX=PNX+5:PY=PNY+5:GOTO 2810
  282. 2910 '--------------------------------------------------------------------------
  283. 2920 REM merge screens
  284. 2930 GET (0,0)-(639,199),FSCRN
  285. 2940 SCREEN 0:COLOR 7,1,1:CLS:LOCATE 5,1:FILES "*.pic"
  286. 2950 BEEP:LOCATE 1,1:INPUT "Filename (no extension)";MSPEC$:CH=0
  287. 2960 IF MSPEC$="" THEN 2950
  288. 2970 MSPEC$=LEFT$(MSPEC$,8)+".pic":SCREEN 2:OUT &H3D9,7:BLOAD MSPEC$
  289. 2980 PUT (0,0),FSCRN,OR
  290. 2990 GOTO 480
  291. 3000 '--------------------------------------------------------------------------
  292. 3010 REM text position
  293. 3020 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO:MODE=2:GOSUB 3970:LOCATE 11,20
  294. 3030 BEEP:PRINT "Line to start [";RIGHT$(STR$(L),LEN(STR$(L))-1);"]";:INPUT PLIN
  295. 3040 IF PLIN<>0 THEN L=PLIN ELSE L=L
  296. 3050 LOCATE 13,20
  297. 3060 BEEP:PRINT "Column to start [";RIGHT$(STR$(C),LEN(STR$(C))-1);"]";:INPUT PCIN
  298. 3070 IF PCIN<>0 THEN C=PCIN ELSE C=C
  299. 3080 GOSUB 4030
  300. 3090 GOTO 480
  301. 3100 '--------------------------------------------------------------------------
  302. 3110 REM goto pixel position
  303. 3120 GET (0,0)-(639,199),FSCRN:GOSUB 3700:PUT (0,0),FSCRN,PSET
  304. 3130 COL=PNX+5:ROW=PNY+5
  305. 3140 PRESET (COL,ROW)
  306. 3150 GOTO 480
  307. 3160 '--------------------------------------------------------------------------
  308. 3170 REM Move / copy blocks
  309. 3180 GOSUB 3970
  310. 3190 LOCATE 11,20:PRINT"P - Point to area to be moved/copied"
  311. 3200 LOCATE 12,20:PRINT"L - Specify new location of block"
  312. 3210 LOCATE 13,20:PRINT"B - Put block on new location"
  313. 3220 LOCATE 14,20:PRINT"E - Erase specified area"
  314. 3230 LOCATE 15,20:PRINT"C - Change activity; currently ";MOVACT$
  315. 3240 A$=INKEY$:IF A$="" THEN 3240
  316. 3250 IF A$="P" OR A$="p" THEN 3310
  317. 3260 IF A$="L" OR A$="l" THEN GOSUB 4030:GOSUB 3700:MOVPLCX=PNX+5:MOVPLCY=PNY+5:GOTO 3180
  318. 3270 IF A$="B" OR A$="b" THEN GOSUB 4030:IF MOVACT$="move" THEN PUT (MOVULX,MOVULY),MVER,XOR:PUT (MOVPLCX,MOVPLCY),MVER:GOTO 480 ELSE PUT (MOVPLCX,MOVPLCY),MVER:GOTO 480
  319. 3280 IF A$="E" OR A$="e" THEN GOSUB 4030:LINE (MOVULX,MOVULY)-(MOVLRX,MOVLRY),0,BF:GOTO 480
  320. 3290 IF A$="C" OR A$="c" THEN SOUND 3000,.3:IF MOVACT$="move" THEN MOVACT$="copy":LOCATE 15,51:PRINT MOVACT$:GOTO 3240 ELSE MOVACT$="move":LOCATE 15,51:PRINT MOVACT$:GOTO 3240
  321. 3300 IF A$=CHR$(27) THEN GOSUB 4030:GOTO 480 ELSE SOUND 3000,.3:GOTO 3240
  322. 3310 GOSUB 4030:GET (0,0)-(639,199),FSCRN
  323. 3320 GOSUB 3700:MOVULX=PNX+5:MOVULY=PNY+5
  324. 3330 GOSUB 3700:MOVLRX=PNX+5:MOVLRY=PNY+5
  325. 3340 GET (MOVULX,MOVULY)-(MOVLRX,MOVLRY),MVER
  326. 3350 GOTO 3180
  327. 3360 '-------------------------------------------------------------------------
  328. 3370 REM new file
  329. 3380 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO:MODE=3:IF CH=0 THEN 360
  330. 3390 GOSUB 3970:LOCATE 11,20
  331. 3400 PRINT"are you sure? (y/n)":BEEP
  332. 3410 A$=INKEY$:IF A$="" THEN 3410
  333. 3420 IF A$="N" OR A$="n" THEN GOSUB 4030:GOTO 480
  334. 3430 IF A$="Y" OR A$="y" THEN CH=0:GOTO 360 ELSE SOUND 3000,.3:GOTO 3410
  335. 3440 '--------------------------------------------------------------------------
  336. 3450 '           OTHER STUFF (NOT CALLED BY USER, EXCEPT HELP)
  337. 3460 '--------------------------------------------------------------------------
  338. 3470 REM help
  339. 3480 GET (0,0)-(639,199),FSCRN
  340. 3490 FOR KO=15 TO 17:KEY (KO) OFF:NEXT KO:SCREEN 0,0,0:COLOR 7,1,1:CLS:LOCATE 25,16,0
  341. 3500 BLOAD "help.scr"
  342. 3510 A$=INKEY$:IF A$="" THEN 3510
  343. 3520 IF A$=CHR$(27) THEN SCREEN 2:OUT &H3D9,7:PUT (0,0),FSCRN:RETURN
  344. 3530 IF ASC(A$)=0 THEN PRINT"Sorry! You have to REGISTER to get this feature!":FOR X=1 TO 1000:NEXT X:LOCATE 25,16,0:PRINT SPACE$(48):GOTO 3510 ELSE SOUND 3000,.3:GOTO 3510
  345. 3540 '--------------------------------------------------------------------------
  346. 3550 REM error trapping routines
  347. 3560 IF ERR>70 AND ERR<73 THEN 3570 ELSE 3620 'disk errors
  348. 3570 GOSUB 3970
  349. 3580 LOCATE 11,20:PRINT "One of the following is going on:"
  350. 3590 LOCATE 12,20:PRINT "Disk write protected; Disk not ready."
  351. 3600 LOCATE 14,20:PRINT "Please correct it, and press any key."
  352. 3610 A$=INKEY$:IF A$="" THEN 3610 ELSE RESUME
  353. 3620 IF ERR=53 THEN RESUME NEXT 'file not found err
  354. 3630 IF ERR=5 AND ERL=510 AND L>25 THEN L=25:LOCATE L,C:SOUND 3000,.3:RESUME 480
  355. 3640 IF ERR=5 AND ERL=520 THEN C=1:LOCATE L,C:SOUND 3000,.3:RESUME 480
  356. 3650 IF ERR=5 AND ERL=530 AND C>80 THEN C=80:LOCATE L,C:PRINT A$:RESUME 480
  357. 3660 IF ERR=7 AND ERL=1400 THEN GOSUB 3980:
  358. 3661 LOCATE 12,20:PRINT"There is not enough memory to load"
  359. 3662 LOCATE 13,20:PRINT"a second copy of COMMAND.COM"
  360. 3663 LOCATE 15,25:PRINT"Press any key to continue."
  361. 3664 A$=INKEY$:IF A$="" THEN 3664 else GOSUB 4030:RESUME 480
  362. 3670 PRINT"weird error. I give up.":STOP
  363. 3680 '--------------------------------------------------------------------------
  364. 3690 REM The Pointer
  365. 3700 LINE (PNX,PNY)-(PNX+10,PNY+10),0,BF
  366. 3710 PRESET (PNX+5,PNY+5)
  367. 3720 DRAW"c1"
  368. 3730 DRAW"bm +0,-1  nu4"
  369. 3740 DRAW"bm +0,+2  nd4"
  370. 3750 DRAW"bm +1,-1  nr4"
  371. 3760 DRAW"bm -2,+0  nl4"
  372. 3770 GET (PNX,PNY)-(PNX+10,PNY+10),PNTR
  373. 3780 PUT (0,0),FSCRN,PSET
  374. 3790 PUT (PNX,PNY),PNTR,OR
  375. 3800 A$=INKEY$:IF A$="" THEN GOTO 3800
  376. 3810 IF A$=CHR$(0)+CHR$(72) THEN PUT (PNX,PNY),PNTR:PNY=PNY-1:GOTO 3910 'up
  377. 3820 IF A$=CHR$(0)+CHR$(75) THEN PUT (PNX,PNY),PNTR:PNX=PNX-1:GOTO 3910 'left
  378. 3830 IF A$=CHR$(0)+CHR$(80) THEN PUT (PNX,PNY),PNTR:PNY=PNY+1:GOTO 3910 'down
  379. 3840 IF A$=CHR$(0)+CHR$(77) THEN PUT (PNX,PNY),PNTR:PNX=PNX+1:GOTO 3910 'right
  380. 3850 IF A$=CHR$(56) THEN PUT (PNX,PNY),PNTR:PNY=PNY-10:GOTO 3910 'up 10
  381. 3860 IF A$=CHR$(52) THEN PUT (PNX,PNY),PNTR:PNX=PNX-20:GOTO 3910 'left 20
  382. 3870 IF A$=CHR$(50) THEN PUT (PNX,PNY),PNTR:PNY=PNY+10:GOTO 3910 'down 10
  383. 3880 IF A$=CHR$(54) THEN PUT (PNX,PNY),PNTR:PNX=PNX+20:GOTO 3910 'rght 20
  384. 3890 IF A$=CHR$(27) THEN PUT (PNX,PNY),PNTR:RETURN 480
  385. 3900 IF A$=CHR$(13) THEN PUT (0,0),FSCRN,PSET:RETURN ELSE SOUND 3000,.3:GOTO 3800
  386. 3910 PUT (PNX,PNY),PNTR:GOTO 3800
  387. 3920 '--------------------------------------------------------------------------
  388. 3930 '                 WORKING ON THAT NICE LITTLE BOX
  389. 3940 '                   IN THE MIDDLE OF THE SCREEN
  390. 3950 '--------------------------------------------------------------------------
  391. 3960 REM store
  392. 3970 GET (142,74)-(498,126),BOX
  393. 3980 LINE (142,74)-(498,126),0,BF
  394. 3990 LINE (146,76)-(494,124),1,B
  395. 4000 RETURN
  396. 4010 '--------------------------------------------------------------------------
  397. 4020 REM recall
  398. 4030 PUT (142,74),BOX,PSET
  399. 4040 RETURN
  400.